package Waya::SGFParser;

use warnings;
use strict;

use base 'Exporter';

our @EXPORT = ('sgf_parse');

my $sgf;

sub sgf_parse {
    $sgf = shift;
    my $chr;

    $sgf = scalar reverse "$sgf\n";

    my $prev_chr = "\n";
    for(;;) {
        $chr = chop $sgf;
        # Collect chars til we see '(' as first char on a line this allows
        # emails and news postings to be read - the pre-amble will get skipped
        # here.

        if (($prev_chr eq "\n") && ($chr eq '(')) {
                # got the first line of the SGF part
                my $game = sgf_process_variation();
                return bless $game, 'Waya::SGF';
        } elsif (($chr eq '') && !length($sgf)) {
            die qq!Couldn't find the start of the SGF part (no "(" as first character on a line).\n!;
        }
        $prev_chr = $chr;
    }
}


sub sgf_process_variation {
    my @result;

    # subvariations, can come at the end of this sequence
    my $variation = bless [], 'Waya::Variation';

    my $prev_chr = '(';          # we start off inside the first '('
    for (;;) {

        my $chr;
        do { $chr = chop $sgf }
        until $chr ne ' ' && $chr ne "\n" && $chr ne '\t';

        if ($chr eq '') {
            die qq!sgf_process_variation: end of file without closing ")".\n!;
        } elsif ($chr eq '(') {

            # If we didn't just see a ')', then this is the first
            # subvariation, add the variation container to the result node
            # list.

            push @result, $variation unless $prev_chr eq ')';

            push @$variation, sgf_process_variation();
            $chr = ')';                     # done with variation
        } elsif ($chr eq ')') {              # end of a variation
            return \@result;
        } else {                                # a node
            $sgf .= $chr if $chr ne ';';     # hmm, missing ';'?
            push @result, sgf_process_node();
        }
        $prev_chr = $chr;
    } 
}


sub sgf_process_node {
    my %props;
    for(;;) {

        # get property id

        my $prop_id = '';

        my $chr;
        do { $chr = chop $sgf }
        until $chr ne ' ' && $chr ne "\n" && $chr ne '\t';

        while ($chr ne '') {

            # A property id consists of uppercase characters only. Some SGF
            # software uses a mixture of uppercase and lowercase letters, but we
            # ignore lowercase letters here.

            if ($chr ge 'A' && $chr le 'Z') {
                $prop_id .= $chr;
            } elsif ($chr lt 'a' || $chr gt 'z') {
                $sgf .= $chr;
                last;
            }
            $chr = chop $sgf;
        }

        # Got property id, now process the property value(s).
        # A property is an id followed by value(s).
        # Property vals consists of stuff inside brackets [].

        last if $prop_id eq '';


        my @val;
        while (1) {
            my $chr;
            do { $chr = chop $sgf }
            until $chr ne ' ' && $chr ne "\n" && $chr ne '\t';

            if ($chr ne '[') {
                $sgf .= $chr;
                last;  # no more property values, continue with next prop id
            }
            my $prop_val = '';
            for(;;) {
                $chr = chop $sgf;
                if ($chr eq "\\") {
                    $prop_val .= chop $sgf;
                } elsif ($chr eq ']') {
                    push @val, $prop_val;
                    last;    # continue with next property value
                } elsif ($chr eq '' && !length($sgf)) {
                    warn "Unterminated property: $prop_val\n";
                    push @val, $prop_val;
                    last;    # continue with next property value
                } else {
                    $prop_val .= $chr;
                }
            }
        }

        $props{$prop_id} = (@val == 1) ? $val[0] : \@val;
    }

    bless \%props, 'Waya::Node';
}


1;
